{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Thumbnails;

interface

uses Classes, SyncObjs, Bitmaps;

type
  TAHMThumbnailRequest = class
  private
    FURL: WideString;
    FWidth: Single;
    FHeight: Single;
    FBitmap: TAHMBitmap;
  public
    constructor Create(const URL: WideString; Width, Height: Single);
    property URL: WideString read FURL write FURL;
    property Width: Single read FWidth write FWidth;
    property Height: Single read FHeight write FHeight;
    property Bitmap: TAHMBitmap read FBitmap write FBitmap;
  end;

  TAHMThumbnailRequests = class
  private
    FList: TList;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    function Find(const URL: WideString): TAHMThumbnailRequest;
    procedure Add(Request: TAHMThumbnailRequest);
    procedure Remove(Request: TAHMThumbnailRequest);
    procedure Clear;
  end;

  TAHMThumbnailGenerator = class;

  TAHMThumbnailThread = class(TThread)
  private
    FOwner: TAHMThumbnailGenerator;
  public
    constructor Create(Owner: TAHMThumbnailGenerator);
    procedure Execute; override;
  end;

  TAHMThumbnailGenerator = class
  private
    FLock: TCriticalSection;
    FSignal: TEvent;
    FThread: TAHMThumbnailThread;
    FRequest: TAHMThumbnailRequest;
    FRequests: TAHMThumbnailRequests;
  protected
    procedure Shutdown;
    procedure ThumbnailReady;
    property Request: TAHMThumbnailRequest read FRequest;
    property Signal: TEvent read FSignal;
  public
    constructor Create;
    destructor Destroy; override;
    function MakeImageThumb(const URL: WideString; Width, Height: Single): TAHMBitmap;
  end;

implementation

uses SysUtils;

// TAHMThumbnailRequest

constructor TAHMThumbnailRequest.Create(const URL: WideString; Width, Height: Single);
begin
  inherited Create;

  FURL := URL;
  FWidth := Width;
  FHeight := Height;
end;

// TAHMThumbnailRequests

constructor TAHMThumbnailRequests.Create;
begin
  inherited;

  FList := TList.Create;
end;

destructor TAHMThumbnailRequests.Destroy;
begin
  Clear;
  FList.Free;

  inherited;
end;

function TAHMThumbnailRequests.Find(const URL: WideString): TAHMThumbnailRequest;
var
  i: Integer;
begin
  // Set default result - not found
  Result := nil;

  // Perform simple linear search
  for i := 0 to Pred(FList.Count) do
    if TAHMThumbnailRequest(FList[i]).URL = URL then
    begin
      Result := TAHMThumbnailRequest(FList[i]);
      Break;
    end;
end;

procedure TAHMThumbnailRequests.Add(Request: TAHMThumbnailRequest);
begin
  if Assigned(Request) then
    FList.Add(Request);
end;

procedure TAHMThumbnailRequests.Remove(Request: TAHMThumbnailRequest);
begin
  if Assigned(Request) then
  begin
    FList.Remove(Request);
    Request.Free;
  end;
end;

procedure TAHMThumbnailRequests.Clear;
var
  i: Integer;
begin
  for i := 0 to Pred(FList.Count) do
  begin
    // Free any cached uncollected bitmaps
    TAHMThumbnailRequest(FList[i]).Bitmap.Free;
    TAHMThumbnailRequest(FList[i]).Free;
  end;

  FList.Clear;
end;

// TAHMThumbnailThread

constructor TAHMThumbnailThread.Create(Owner: TAHMThumbnailGenerator);
begin
  // Create thread in suspended state
  inherited Create(True);

  // Store owner property for notifications later
  FOwner := Owner;

  // We don't want this thread to steal time from DirectShow
  Priority := tpIdle;

  // Okay, resume thumbnail thread now
  Resume;
end;

procedure TAHMThumbnailThread.Execute;
var
  Bitmap: TAHMBitmap;
begin
  // Thread keeps looping until told to exit
  while not Terminated do
  begin
    // Wait for a thumbnail request to be signalled
    if (FOwner.Signal.WaitFor(200) = wrSignaled) and Assigned(FOwner.Request) then
    begin
      // Clear the signal ready for next time
      FOwner.Signal.ResetEvent;

      // Create a new bitmap instance to cache thumbnail
      Bitmap := TAHMBitmap.Create(FOwner.Request.URL);
      Bitmap.PreserveAspect := True;
      Bitmap.Width := FOwner.Request.Width;
      Bitmap.Height := FOwner.Request.Height;

      // Load the bitmap, which takes a while...
      Bitmap.LoadFromURL(FOwner.Request.URL);

      // Bitmap should now be loaded, check main thread hasn't aborted request
      if Terminated then
        Bitmap.Free
      else
      begin
        // Notify main thread that thumbnail is ready
        FOwner.Request.Bitmap := Bitmap;
        FOwner.ThumbnailReady;
      end;
    end;
  end;
end;

// TAHMThumbnailGenerator

constructor TAHMThumbnailGenerator.Create;
begin
  inherited;

  FLock := TCriticalSection.Create;
  FSignal := TSimpleEvent.Create;
  FRequests := TAHMThumbnailRequests.Create;
  FThread := TAHMThumbnailThread.Create(Self);
end;

destructor TAHMThumbnailGenerator.Destroy;
begin
  Shutdown;

  FThread.Free;
  FSignal.Free;
  FRequests.Free;
  FLock.Free;

  inherited;
end;

procedure TAHMThumbnailGenerator.ThumbnailReady;
begin
  // This method is called by thread when thumbnail is generated
  FLock.Enter;
  try
    // Add finished request to our pending results
    FRequests.Add(FRequest);

    // Thread is now available for another request
    FRequest := nil;
  finally
    FLock.Leave;
  end;
end;

procedure TAHMThumbnailGenerator.Shutdown;
begin
  FLock.Enter;
  try
    // Close thread gracefully
    FThread.Terminate;
    FSignal.SetEvent;
    FThread.WaitFor;

    // Free our stale request
    FreeAndNil(FRequest);

    // Remove all pending requests
    FRequests.Clear;
  finally
    FLock.Leave;
  end;
end;

function TAHMThumbnailGenerator.MakeImageThumb(const URL: WideString; Width, Height: Single): TAHMBitmap;
var
  Request: TAHMThumbnailRequest;
begin
  // Set default result - thumbnail not available
  Result := nil;

  FLock.Enter;
  try
    // Check for a cached request for this URL
    Request := FRequests.Find(URL);
    if Assigned(Request) then
    begin
      Result := Request.Bitmap;
      FRequests.Remove(Request);
      Exit;
    end;

    // No cached result, quit if thread is currently busy
    if Assigned(FRequest) then Exit;

    // Signal thread to handle the thumbnail request
    FRequest := TAHMThumbnailRequest.Create(URL, Width, Height);
    FSignal.SetEvent;
  finally
    FLock.Leave;
  end;
end;


end.
